home *** CD-ROM | disk | FTP | other *** search
/ Graphics & Sound Explorer / Graphics & Sound Explorer.iso / programs / artshow / artshow.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-27  |  26.1 KB  |  1,013 lines
  1. {************************************************}
  2. {   ArtShow 2.2                                  }
  3. {   Copyright 1991 Doug Overmyer                 }
  4. {************************************************}
  5.  
  6. program ArtShow;
  7.  
  8. {$R ARTSHoW.RES}
  9.  
  10. uses OGL1,OGL2,OGL3,WinTypes, WinProcs, WObjects, StdDlgs,
  11.     Strings,WOPlus,StdWnds;
  12.  
  13. const
  14.   AS_Name =  'ArtShow';
  15.   cm_FileOpen =   101;
  16.   as_AboutSt1 =   102;
  17.   as_AboutSt2 =   103;
  18.   as_AboutSt3 =   106;
  19.   cm_FileWin  =   199;
  20.   cm_Start    =   201;
  21.   cm_Stop      =     301;
  22.   cm_Back   =     351;
  23.   cm_About      =     401;
  24.   cm_ZoomOn  =    501;
  25.   cm_ZoomOff =    502;
  26.   cm_BPSolid =    601;
  27.   cm_BP10  =      603;
  28.   cm_BP15  =      604;
  29.   cm_BP30 =       605;
  30.   cm_BP50 =       606;
  31.   cm_BP70   =     607;
  32.   cm_BPHorizontal=609;
  33.   cm_BPVertical=  611;
  34.   cm_BPDiagonal=  613;
  35.   cm_BPHatch=     615;
  36.   cm_BPPebble=    617;
  37.   cm_BPBrick=     619;
  38.  
  39.   cm_BCBlack =    700;
  40.   cm_BCWhite =    701;
  41.   cm_BCRed  =     702;
  42.   cm_BCGreen =    703;
  43.   cm_BCBlue =     704;
  44.   cm_BCCyan =     705;
  45.   cm_BCMagenta =  706;
  46.   cm_BCYellow  =  707;
  47.   cm_FullScreen = 801;
  48.   id_BN1 =        901;
  49.   id_BN2 =        902;
  50.   id_BN3 =        903;
  51.   id_BN4 =        904;
  52.   id_BN5 =        905;
  53.   id_BN6 =        906;
  54.   cm_BPPSolid =    1001;
  55.   cm_BPP10  =      1003;
  56.   cm_BPP15  =      1004;
  57.   cm_BPP30 =       1005;
  58.   cm_BPP50 =       1006;
  59.   cm_BPP70   =     1007;
  60.   cm_BPPHorizontal=1009;
  61.   cm_BPPVertical=  1011;
  62.   cm_BPPDiagonal=  1013;
  63.   cm_BPPHatch=     1015;
  64.   cm_BPPPebble=    1017;
  65.   cm_BPPBrick=     1019;
  66.  
  67.   cm_BCPBlack =    1100;
  68.   cm_BCPWhite =    1101;
  69.   cm_BCPRed  =     1102;
  70.   cm_BCPGreen =    1103;
  71.   cm_BCPBlue =     1104;
  72.   cm_BCPCyan =     1105;
  73.   cm_BCPMagenta =  1106;
  74.   cm_BCPYellow  =  1107;
  75.   idm_RunCP   =    1201;
  76.   idm_About =      1202;
  77.   idm_IconBar =    1203;
  78.   idm_MenuBar =    1204;
  79.   cm_FileBye  =    1301;
  80.  
  81.   fsPathName =    79;
  82. {*****************************************************************}
  83. {T Y P E S }
  84. {*****************************************************************}
  85. type
  86.   TASApp = object(TApplication)
  87.   procedure InitMainWindow; virtual;
  88. end;
  89.  
  90. PASFileWin = ^TASFileWin;
  91. TASFileWin = object(TFileWindow)
  92.     constructor Init(AParent:PWindowsObject;ATitle,AFileName:PChar);
  93.     procedure CMFileBye(var Msg:TMessage);virtual cm_First+cm_FileBye;
  94.   destructor Done;virtual;
  95. end;
  96.  
  97. PASIconBar = ^TASIconBar;
  98. TASIconBar = object(TGWindow)
  99.     BN1,BN2,BN3,BN4,BN5,BN6:PODButton;
  100.   HFloatMenu:hMenu;
  101.   HPopUpMenu:hMenu;
  102.   constructor Init(AParent:PWindowsObject;ATitle:PChar);
  103.   destructor Done;virtual;
  104.   procedure SetupWindow;virtual;
  105.   procedure WMDrawItem(var Msg:TMessage);virtual wm_First+wm_DrawItem;
  106.     procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
  107.   procedure WMMove(var Msg:TMessage); virtual wm_First+wm_Move;
  108.   procedure WMNCLButtonDown(var Msg:TMessage);virtual wm_First+wm_NCLButtonDown;
  109.   procedure DefChildProc(var Msg: TMessage); virtual;
  110.     procedure IDBN1(Var Msg:TMessage);virtual id_First+id_BN1;
  111.   procedure IDBN2(Var Msg:TMessage);virtual id_First+id_BN2;
  112.   procedure IDBN3(Var Msg:TMessage);virtual id_First+id_BN3;
  113.   procedure IDBN4(Var Msg:TMessage);virtual id_First+id_BN4;
  114.   procedure IDBN5(Var Msg:TMessage);virtual id_First+id_BN5;
  115.   procedure IDBN6(Var Msg:TMessage);virtual id_First+id_BN6;
  116.   procedure WMCommand(Var Msg:TMessage);virtual wm_First+wm_Command;
  117. end;
  118.  
  119. PASAboutDlg = ^TASAboutDlg;
  120. TASAboutDlg = object(TDialog)
  121.   CurBrush:HBrush;
  122.   Is_Timer:Boolean;
  123.   Logo:HBitmap;
  124.     procedure WMCtlColor(var Msg:TMessage);virtual wm_First + wm_CtlColor;
  125.   procedure SetupWindow;virtual;
  126.   procedure WMTimer(var Msg:TMessage);virtual wm_First+wm_Timer;
  127.   function CanClose:Boolean;virtual;
  128. end;
  129.  
  130. PASWindow = ^TASWindow;
  131. TASWindow = object(TGWindow)
  132.         IconBar:PASIconBar;
  133.       FileWin:PASFileWin;
  134.     FileName: array[0..fsPathName] of Char;
  135.     Bitmap:PGBitmap;
  136.     Timer_Set :Boolean;
  137.     Is_Running :Boolean;
  138.     Slide_Ptr :Integer;
  139.     Slides :PCollection;
  140.     TheIcon : HIcon;
  141.     CSBr1,CSBr2:HBrush;
  142.     CSBmp:HBitmap;
  143.     hPal:HPalette;
  144.     IsFullScreen:Boolean;
  145.     IsShowMenu:Boolean;
  146.     constructor Init(ATitle: PChar);
  147.     destructor Done; virtual;
  148.     procedure SetupWindow;virtual;
  149.     procedure CMFileOpen(var Msg: TMessage); virtual cm_First + cm_FileOpen;
  150.     procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
  151.         function  OpenFile(Name:Pchar):Boolean;virtual;
  152.     function  DrawToWindow:Boolean;virtual;
  153.     procedure ShowNext;virtual;
  154.     procedure WMTimer(var Msg:TMessage);virtual wm_First+wm_Timer;
  155.     procedure CMStart(var Msg:TMessage);virtual cm_First+cm_Start;
  156.     procedure CMStop(var Msg:TMessage);virtual cm_First+cm_Stop;
  157.     procedure CMBack(var Msg:TMessage);virtual cm_first+cm_Back;
  158.     procedure WMRButtonDown(var Msg:TMessage);virtual wm_First+wm_RButtonDown;
  159.     procedure WMLButtonDown(var Msg:TMessage);virtual wm_First+wm_LButtonDown;
  160.     procedure WMMButtonDown(var Msg:TMessage);virtual wm_First+wm_MButtonDown;
  161.     procedure CMAbout(var Msg:TMessage);virtual cm_First + cm_About;
  162.     procedure CMBPSolid(var Msg:TMessage);virtual cm_First+cm_BPSolid;
  163.       procedure CMBP10(var Msg:TMessage);virtual cm_First+cm_BP10;
  164.       procedure CMBP15(var Msg:TMessage);virtual cm_First+cm_BP15;
  165.       procedure CMBP30(var Msg:TMessage);virtual cm_First+cm_BP30;
  166.       procedure CMBP50(var Msg:TMessage);virtual cm_First+cm_BP50;
  167.       procedure CMBP70(var Msg:TMessage);virtual cm_First+cm_BP70;
  168.       procedure CMBPHorizontal(var Msg:TMessage);virtual cm_First+cm_BPHorizontal;
  169.       procedure CMBPVertical(var Msg:TMessage);virtual cm_First+cm_BPVertical;
  170.       procedure CMBPDiagonal(var Msg:TMessage);virtual cm_First+cm_BPDiagonal;
  171.       procedure CMBPHatch(var Msg:TMessage);virtual cm_First+cm_BPHatch;
  172.       procedure CMBPPebble(var Msg:TMessage);virtual cm_First+cm_BPPebble;
  173.       procedure CMBPBrick(var Msg:TMessage);virtual cm_First+cm_BPBrick;
  174.     procedure CMBCBlack(var Msg:TMessage);virtual cm_First+cm_BCBlack;
  175.     procedure CMBCWhite(var Msg:TMessage);virtual cm_First+cm_BCWhite;
  176.     procedure CMBCRed(var Msg:TMessage);virtual cm_First+cm_BCRed;
  177.     procedure CMBCGreen(var Msg:TMessage);virtual cm_First+cm_BCGreen;
  178.     procedure CMBCBlue(var Msg:TMessage);virtual cm_First+cm_BCBlue;
  179.     procedure CMBCCyan(var Msg:TMessage);virtual cm_First+cm_BCCyan;
  180.     procedure CMBCMagenta(var Msg:TMessage);virtual cm_First+cm_BCMagenta;
  181.     procedure CMBCYellow(var Msg:TMessage);virtual cm_First+cm_BCYellow;
  182.     procedure CMFullScreen(var Msg:TMessage);virtual cm_First+cm_FullScreen;
  183.     procedure CMFileWin(var Msg:TMessage);virtual cm_First + cm_FileWin;
  184.     procedure WMChar(Var Msg:TMessage);virtual wm_First+wm_Char;
  185.       procedure WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  186.     procedure SetupMenu;virtual;
  187. end;
  188.  
  189. type
  190. PSlideRec = ^TSlideRec;
  191. TSlideRec = object(TObject)
  192.     FileName : PChar;
  193.   Duration: Integer;
  194.     constructor Init(NewFileName:PChar;NewDuration:Integer);
  195.     destructor  Done;virtual;
  196. end;
  197. {*****************************************************************}
  198. {G L O B A L S }
  199. {*****************************************************************}
  200. var
  201.     MainWin:PASWindow;
  202. {*****************************************************************}
  203. {M E T H O D S }
  204. {*****************************************************************}
  205.  
  206. { Construct the TASApp's MainWindow of type TASWindow }
  207. {InitMainWindow}
  208. procedure TASApp.InitMainWindow;
  209. begin
  210.     CmdShow := sw_Maximize;
  211.   MainWindow := New(PASWindow, Init(AS_Name));
  212.   MainWin := PASWindow(MainWindow);
  213. end;
  214.  
  215. {*****************************************************************}
  216. {Init}
  217. constructor TASWindow.Init(ATitle: PChar);
  218. var
  219.     ARect:TMathRect;
  220.   BackColor:TSystemColor;
  221.   aPalette:TPalette ;
  222.   LogBrush:TLogBrush;
  223. begin
  224.   TGWindow.Init(nil, ATitle);
  225.   Attr.Style := Attr.Style or ws_DlgFrame  ;
  226.   BackColor.Init(sc_Window);
  227.   Port_AddBrushPattern(bp_User1,'AS_Brush');
  228.   Brush := New(PBrush,Init(@BackColor));
  229.   {Brush^.Pattern := bp_Nil;}
  230.   Brush^.Pattern := bp_User1;
  231.   BackColor.Done; 
  232.   Bitmap := New(PGBitmap,Init(0,0,0,0,tc_NoTools));
  233.   Picture^.Add(Bitmap);
  234.   Timer_Set := False;
  235.   Slide_Ptr := 0;
  236.   Is_Running := False;
  237.   IsFullScreen := False;
  238.   IsShowMenu := False;
  239.   Slides := New(PCollection,Init(100,100));
  240.   BitMap^.LoadBmpResource('AS_LOGO',Space);
  241.     DrawToWindow;
  242.   IconBar := New(PASIconBar,Init(@Self,'Control Bar'));
  243.   FileWin := nil;
  244.   CSBMP :=LoadBitmap(HInstance,'AS_Brush3');
  245.   CSBr1 :=CreatePatternBrush(CSBMP);
  246.   DeleteObject(CSBMP);
  247.   CSBMP :=LoadBitmap(HInstance,'AS_Brush4');
  248.   CSBr2 :=CreatePatternBrush(CSBMP);
  249.   DeleteObject(CSBMP);
  250. end;
  251.  
  252. {Done}
  253. destructor TASWindow.Done;
  254. var
  255.     Msg:TMessage;
  256. begin
  257.   Dispose(Slides,Done);
  258.     If (FileWin <> nil) and (FileWin^.HWindow <> 0) then
  259.       FileWin^.CMFileBye(Msg);
  260.   if Timer_Set then
  261.       begin
  262.        KillTimer(HWindow,1);
  263.        Timer_Set := False;
  264.       end;
  265.   TGWindow.Done;
  266.   DeleteObject(CSBr1);
  267.   DeleteObject(CSBr2);
  268. end;
  269.  
  270. procedure TASWindow.SetupWindow;
  271. var
  272.     SysMenu:HMenu;
  273. begin
  274.     TGWindow.SetupWindow;
  275.   SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'AS_Icon'));
  276.   Sysmenu := GetSystemMenu(hWindow,false);
  277.   AppendMenu(SysMenu,MF_Separator,0,nil);
  278.   AppendMenu(SysMenu,0,idm_IconBar,'Control Bar');
  279.   AppendMenu(SysMenu,0,idm_MenuBar,'Menu Bar');
  280.   AppendMenu(SysMenu,0,idm_RunCP,'Control Panel');
  281.   AppendMenu(SysMenu,MF_Separator,0,nil);
  282.   AppendMenu(Sysmenu,0,idm_About,'About...');
  283. end;
  284.  
  285. {CMFileOpen}
  286. procedure TASWindow.CMFileOpen(var Msg: TMessage);
  287. var
  288.   TempName: array[0..fsPathName] of Char;
  289.   CaptionBuffer: array [0..fsPathName+12{AS_Name} +2{': '} +1{#0}] of Char;
  290.   TheFile :PTextStream;
  291.   BPtr : PChar;
  292.   NewFileName:Array[0..50] of Char;
  293.   NewDuration:Integer;
  294.   Err1:Integer ;
  295. begin
  296.     SetWindowText(HWindow, AS_Name);
  297.   Is_Running := False;
  298.   If Slides^.Count > 0 then
  299.        begin
  300.     Dispose(Slides,Done);
  301.     Slides := New(PCollection,Init(100,100));
  302.     Slide_Ptr := 0;
  303.     end;
  304.   if Application^.ExecDialog(New(PFileDialog,
  305.             Init(@Self, PChar(sd_FileOpen), StrCopy(TempName, '*.shw'))))
  306.             = id_Ok then
  307.     begin
  308.     StrCopy(FileName, TempName);
  309.     StrCopy(CaptionBuffer, 'Art Show:');
  310.     StrCat(CaptionBuffer, ': ');
  311.     StrCat(CaptionBuffer, AnsiLower(FileName));
  312.     SetWindowText(HWindow, CaptionBuffer);
  313.  
  314.     TheFile := New(PTextStream,Init(FileName,stOpen,1024));
  315.     While TheFile^.IsEOF = False  do
  316.             begin
  317.       StrCopy(NewFileName,TheFile^.GetNext);
  318.       BPtr := TheFile^.GetNext;
  319.       If BPtr <> nil then
  320.           Val(BPtr,NewDuration,Err1)
  321.       else
  322.           Err1 := 1;
  323.       if Err1 = 0 then
  324.             Slides^.Insert(New(PSlideRec,Init(NewFileName,NewDuration)));
  325.       end;
  326.     Dispose(TheFile,Done);
  327.     end;
  328. end;
  329.  
  330. function TASWindow.OpenFile(Name: PChar): Boolean;
  331. var
  332.   aPoint:TGPoint;
  333. begin
  334.      Bitmap^.LoadBMPFile(Name, Space) ;
  335.   aPoint.InitDefault;
  336.   BitMap^.PositionAt(@aPoint);
  337.   aPoint.Done;
  338.   OpenFile := True;
  339.     DrawtoWindow;
  340. end;
  341.  
  342. function TASWindow.DrawToWindow: Boolean;
  343. var
  344.   OutRect,ClipRect,MapRect: TMathRect;
  345.   SMCYSCREEN,SMCXSCREEN:Integer;
  346.   CenterPt:TGPoint;
  347.   APalette:TPalette;
  348. begin
  349.   APalette.Init(256,10);
  350.   Bitmap^.GetPalette(APalette);
  351.   Port^.SetPalette(@APalette);
  352.   APalette.Done;
  353.   SMCYSCREEN := GetSystemMetrics(sm_CYScreen);
  354.   SMCXSCREEN := GetSystemMetrics(sm_CXScreen);
  355.  
  356.   OutRect.InitDefault;ClipRect.InitDefault;MapRect.InitDefault;CenterPt.InitDefault;
  357.   if IsFullScreen then
  358.     OutRect.Build(0,0,SMCXSCREEN,SMCYSCREEN)    {set output to screen size}
  359.   else
  360.       GetDisplayRect(OutRect);       {set output size to window client size}
  361.  
  362.   Space^.SetWorldRect(@OutRect);
  363.   OutRect.GetCenter(CenterPt);
  364.   Bitmap^.CenterAt(@CenterPt);       {alter bm's orign,corner so centered}
  365.   MapRect.CopyFrom(@OutRect);        {set mapR to output size, }
  366.   Space^.SetMappingRect(@MapRect);   
  367.   Space^.FitToRectangle(@OutRect);   {adjust zoom}
  368.     CenterPt.Done;OutRect.Done;ClipRect.Done;MapRect.Done;
  369.  
  370.      Invalidate;
  371.   UpdateWindow(HWindow);
  372.   DrawToWindow := True;
  373. end;
  374.  
  375. {WMSize}
  376. procedure TASWindow.WMSize(var Msg: TMessage);
  377. begin
  378.   TWindow.WMSize(Msg);
  379.   DrawToWindow;
  380.   if IconBar <> nil then
  381.         SendMessage(IconBar^.HWindow,wm_Size,0,0);
  382. end;
  383.  
  384. {ShowNext}
  385. procedure TASWindow.ShowNext;
  386. var
  387.     Slide:PSlideRec;
  388.   Msg:TMessage;
  389.   Dur:Word;
  390. begin
  391. if Timer_Set then
  392.     begin
  393.       KillTimer(HWindow,1);
  394.       Timer_Set := False;
  395.     end;
  396. if Slide_Ptr < (Slides^.Count ) then
  397.     begin
  398.   Slide := Slides^.At(Slide_Ptr);
  399.   if StrIComp(Slide^.FileName,'loop') = 0 then
  400.       begin
  401.        Slide_Ptr := 0 ;
  402.     CMStart(Msg) ;
  403.       end
  404.     else
  405.         begin
  406.         Dur := Slide^.Duration ;
  407.       if Dur < 62 then
  408.           Dur := Dur * 1000
  409.       else
  410.           Dur := 60000;
  411.       OpenFile(Slide^.FileName);
  412.       SetTimer(HWindow,1,Dur,nil);
  413.       Timer_Set := True;
  414.       Inc(Slide_Ptr);
  415.       end;
  416.     end;
  417. end;
  418.  
  419. {WMTimer}
  420. procedure TASWindow.WMTimer(var Msg:TMessage);
  421. begin
  422.     KillTimer(HWindow,1);
  423.   Timer_Set := False;
  424.   ShowNext;
  425. end;
  426.  
  427. {CMStart}
  428. procedure TASWindow.CMStart(var Msg:TMessage);
  429. begin
  430.   Is_Running := True;
  431.     ShowNext;
  432. end;
  433.  
  434. {CMStop}
  435. procedure TASWindow.CMStop(var Msg:TMessage);
  436. begin
  437.     if Timer_Set = True then
  438.        begin
  439.        KillTimer(HWindow,1);
  440.     Timer_Set := False;
  441.     end;
  442.   Is_Running := False;
  443. end;
  444.  
  445. {CMBack} {Previous Slide}
  446. procedure TASWindow.CMBack(var Msg:TMessage);
  447. begin
  448.         Slide_Ptr :=Max( Slide_Ptr - 2,0);
  449.     Is_Running := True;
  450.     ShowNext;
  451. end;
  452.  
  453. {WMRButtonDown} {Previous Slide}
  454. procedure TASWindow.WMRButtonDown(var Msg:TMessage);
  455. begin
  456.     SendMessage(HWindow,wm_command,cm_Back,0);
  457. end;
  458.  
  459. {WMLButtonDown} {Next Slide, pls!}
  460. procedure TASWindow.WMLButtonDown(var Msg:TMessage);
  461. begin
  462.     If not Is_Running then
  463.        CMStart(Msg)
  464.   else
  465.        ShowNext;
  466. end;
  467.  
  468. {WMMButtonDown} {Stop Show, pls!}
  469. procedure TASWindow.WMMButtonDown(var Msg:TMessage);
  470. begin
  471.   CMStop(Msg);
  472. end;
  473.  
  474. {CMAbout}
  475. procedure TASWindow.CMAbout(var Msg:TMessage);
  476. var
  477.     HelpDlg : PASAboutDlg;
  478. begin
  479.     HelpDlg := New(PASAboutDlg,Init(@Self,'AS_ABOUTBOX'));
  480.    Application^.ExecDialog(HelpDlg);
  481. end;
  482.  
  483. procedure TASWindow.CMBPSolid(var Msg:TMessage);
  484. begin
  485.   Brush^.Pattern := bp_Solid;
  486. end;
  487.  
  488. procedure TASWindow.CMBP10(var Msg:TMessage);
  489. begin
  490.   Brush^.Pattern := bp_Ten;
  491. end;
  492.  
  493. procedure TASWindow.CMBP15(var Msg:TMessage);
  494. begin
  495.   Brush^.Pattern := bp_Fifteen;
  496. end;
  497.  
  498. procedure TASWindow.CMBP30(var Msg:TMessage);
  499. begin
  500.   Brush^.Pattern := bp_Thirty;
  501. end;
  502.  
  503. procedure TASWindow.CMBP50(var Msg:TMessage);
  504. begin
  505.   Brush^.Pattern := bp_Fifty
  506. end;
  507.  
  508. procedure TASWindow.CMBP70(var Msg:TMessage);
  509. begin
  510.   Brush^.Pattern := bp_Seventy;
  511. end;
  512.  
  513. procedure TASWindow.CMBPHorizontal(var Msg:TMessage);
  514. begin
  515.   Brush^.Pattern := bp_Horizontal;
  516. end;
  517.  
  518. procedure TASWindow.CMBPVertical(var Msg:TMessage);
  519. begin
  520.   Brush^.Pattern := bp_Vertical;
  521. end;
  522.  
  523. procedure TASWindow.CMBPDiagonal(var Msg:TMessage);
  524. begin
  525.   Brush^.Pattern := bp_Diagonal;
  526. end;
  527.  
  528. procedure TASWindow.CMBPHatch(var Msg:TMessage);
  529. begin
  530.   Brush^.Pattern := bp_Hatch;
  531. end;
  532.  
  533. procedure TASWindow.CMBPPebble(var Msg:TMessage);
  534. begin
  535.   Brush^.Pattern := bp_Pebble;
  536. end;
  537.  
  538. procedure TASWindow.CMBPBrick(var Msg:TMessage);
  539. begin
  540.   Brush^.Pattern := bp_Brick;
  541. end;
  542.  
  543. procedure TASWindow.CMBCBlack(var Msg:TMessage);
  544. var
  545. NewColor:TColor;
  546. begin
  547.     NewColor.Init(ps_Black);
  548.   Brush^.SetColor(@NewColor);
  549.   NewColor.Done;
  550. end;
  551.  
  552. procedure TASWindow.CMBCWhite(var Msg:TMessage);
  553. var
  554. NewColor:TColor;
  555. begin
  556.     NewColor.Init(ps_White);
  557.   Brush^.SetColor(@NewColor);
  558.   NewColor.Done;
  559. end;
  560.  
  561. procedure TASWindow.CMBCRed(var Msg:TMessage);
  562. var
  563. NewColor:TColor;
  564. begin
  565.     NewColor.Init(ps_Red);
  566.   Brush^.SetColor(@NewColor);
  567.   NewColor.Done;
  568. end;
  569.  
  570. procedure TASWindow.CMBCGreen(var Msg:TMessage);
  571. var
  572. NewColor:TColor;
  573. begin
  574.     NewColor.Init(ps_Green);
  575.   Brush^.SetColor(@NewColor);
  576.   NewColor.Done;
  577. end;
  578.  
  579. procedure TASWindow.CMBCBlue(var Msg:TMessage);
  580. var
  581. NewColor:TColor;
  582. begin
  583.     NewColor.Init(ps_Blue);
  584.   Brush^.SetColor(@NewColor);
  585.   NewColor.Done;
  586. end;
  587.  
  588. procedure TASWindow.CMBCCyan(var Msg:TMessage);
  589. var
  590. NewColor:TColor;
  591. begin
  592.     NewColor.Init(ps_Cyan);
  593.   Brush^.SetColor(@NewColor);
  594.   NewColor.Done;
  595. end;
  596.  
  597. procedure TASWindow.CMBCMagenta(var Msg:TMessage);
  598. var
  599. NewColor:TColor;
  600. begin
  601.     NewColor.Init(ps_Magenta);
  602.   Brush^.SetColor(@NewColor);
  603.   NewColor.Done;
  604. end;
  605.  
  606. procedure TASWindow.CMBCYellow(var Msg:TMessage);
  607. var
  608. NewColor:TColor;
  609. begin
  610.     NewColor.Init(ps_Yellow);
  611.   Brush^.SetColor(@NewColor);
  612.   NewColor.Done;
  613. end;
  614.  
  615. procedure TASWindow.CMFullScreen(var Msg:TMessage);
  616. var
  617.     Style:LongInt;
  618. begin
  619.     If IsFullScreen then
  620.       begin
  621.     Style := GetWindowLong(HWindow,gwl_Style);
  622.     Style := Style or ws_Caption;
  623.     SetWindowLong(HWindow,gwl_Style,Style);
  624.     ShowWindow(HWindow,sw_ShowNormal);
  625.          ShowWindow(hWindow,sw_ShowMaximized);
  626.       IsFullScreen := False;
  627.     SetupMenu;
  628.         end
  629.   else
  630.       begin
  631.         IsFullScreen := True;
  632.     Style := GetWindowLong(HWindow,gwl_Style);
  633.     Style := Style and not ws_Caption;
  634.     SetWindowLong(HWindow,gwl_Style,Style);
  635.     SetupMenu;
  636.       ShowWindow(HWindow,sw_ShowNormal);
  637.          ShowWindow(hWindow,sw_ShowMaximized);
  638.         end;
  639. end;
  640.  
  641. procedure TASWindow.WMChar(var Msg:TMessage);
  642. begin
  643.      case Msg.wParamlo of
  644.       $1B:
  645.         begin
  646.       SendMessage(HWindow,wm_Command,cm_FullScreen,0);
  647.         end;
  648.     67,99:
  649.         begin
  650.       if IconBar = nil then
  651.           begin
  652.           IconBar := New(PASIconBar,Init(@Self,'Control Bar'));
  653.         Application^.MakeWindow(IconBar);
  654.         SetFocus(HWindow);
  655.         end
  656.       else
  657.           begin
  658.         SendMessage(IconBar^.HWindow,wm_Close,0,0);
  659.         IconBar := nil;
  660.         end;
  661.       end;
  662.     77,109:
  663.         begin
  664.       IsShowMenu := not IsShowMenu;
  665.       SetupMenu;
  666.       end;
  667.     end;
  668. end;
  669.  
  670. {WMSysCommand}
  671. procedure    TASWindow.WMSysCommand(var Msg:TMessage);
  672. begin
  673.     case Msg.Wparam of
  674.         idm_About:
  675.             Application^.ExecDialog(New(PASAboutDlg,Init(@Self,'AS_About')));
  676.     idm_RunCP:
  677.             begin
  678.         WinExec('Control',1);
  679.         end;
  680.     idm_IconBar:
  681.         begin
  682.       if IconBar = nil then
  683.           begin
  684.           IconBar := New(PASIconBar,Init(@Self,'Control Bar'));
  685.         Application^.MakeWindow(IconBar);
  686.         SetFocus(HWindow);
  687.         end
  688.       else
  689.           begin
  690.         SendMessage(IconBar^.HWindow,wm_Close,0,0);
  691.         IconBar := nil;
  692.         end;
  693.       end;
  694.     idm_MenuBar:
  695.         begin
  696.       IsShowMenu := not IsShowMenu;
  697.       SetupMenu;
  698.       end;
  699.       else
  700.            DefWndProc(Msg);
  701.        end;
  702. end;
  703.  
  704. procedure TASWindow.CMFileWin(var Msg:TMessage);
  705. begin
  706.     SetWindowText(HWindow, AS_Name);
  707.   Is_Running := False;
  708.   If Slides^.Count > 0 then
  709.        begin
  710.     Dispose(Slides,Done);
  711.     Slides := New(PCollection,Init(100,100));
  712.     Slide_Ptr := 0;
  713.     end;
  714.     if (FileWin <> nil) and (FileWin^.HWindow > 0) then
  715.       FileWin^.CMFileBye(Msg);
  716.     FileWin := New(PASFileWin,Init(MainWin,'ArtShow Editor',nil));
  717.   Application^.MakeWindow(FileWin);
  718. end;
  719.  
  720. procedure TASWindow.SetupMenu;
  721. begin
  722.     if IsFullScreen then
  723.       if (Attr.menu = 0) then
  724.           Exit
  725.       else
  726.           begin
  727.         Setmenu(HWindow,0);
  728.         DestroyMenu(Attr.Menu);
  729.         Attr.Menu := 0;
  730.         Exit;
  731.         end;
  732.     if (Attr.Menu = 0) and IsShowMenu then
  733.       begin
  734.     Attr.Menu := loadMenu(HInstance,'AS_Menu');
  735.     SetMenu(HWindow,Attr.Menu);
  736.     end
  737.   else  if (Attr.Menu >0) and not IsShowMenu then
  738.       begin
  739.     Setmenu(HWindow,0);
  740.     DestroyMenu(Attr.Menu);
  741.     Attr.Menu := 0;
  742.     end;
  743. end;
  744.  
  745. {*****************************************************************}
  746. {TSlideRec Methods}
  747. constructor TSlideRec.Init(NewFileName:PChar;NewDuration:Integer);
  748. begin
  749.     FileName := StrNew(NewFileName);
  750.   Duration := NewDuration;
  751. end;
  752.  
  753. destructor TSlideRec.Done;
  754. begin
  755.     StrDispose(FileName);
  756. end;
  757.  
  758. {*****************************************************************}
  759. {TASIconBar Methods}
  760.  
  761. constructor TASIconBar.Init(AParent:PWindowsObject;ATitle:PChar);
  762. begin
  763.     TGWindow.Init(AParent,Atitle);
  764.   Attr.Style :=  ws_PopUpWindow or ws_Visible or ws_Caption;
  765.   Bn1 := New(PODButton,Init(@Self,id_Bn1,'Start',0,0,32,20,false,'AS_Bn1'));
  766.   Bn2 := New(PODButton,Init(@Self,id_Bn2,'Stop',32,0,32,20,false,'AS_Bn2'));
  767.   Bn3 := New(PODButton,Init(@Self,id_Bn3,'Back',64,0,32,20,false,'AS_Bn3'));
  768.   Bn4 := New(PODButton,Init(@Self,id_Bn4,'Full Screen',96,0,32,20,false,'AS_Bn4'));
  769.   Bn5 := New(PODButton,Init(@Self,id_Bn5,'Color/Pattern',128,0,32,20,false,'AS_BN5'));
  770.   Bn6 := New(PODButton,Init(@Self,id_Bn6,'FileEdit',160,0,32,20,false,'AS_BN6'));
  771.   HFloatMenu := LoadMenu(HInstance,'AS_FloatMenu');
  772.   HPopUpMenu := GetSubMenu(HFloatMenu,0);
  773. end;
  774.  
  775. destructor TASIconBar.Done;
  776. begin
  777.      Dispose(Bn1,Done);
  778.   Dispose(Bn2,Done);
  779.   Dispose(Bn3,Done);
  780.   Dispose(Bn4,Done);
  781.   Dispose(Bn5,Done);
  782.   Dispose(Bn6,Done);
  783.   DestroyMenu(HFloatMenu);
  784.      TGWindow.Done;
  785.   MainWin^.IconBar := nil;
  786. end;
  787.  
  788. procedure TASIconBar.SetupWindow;
  789. var
  790.   WR,CR:TRect;
  791. begin
  792.   GetClientRect(Parent^.HWindow,CR);
  793.     TGWindow.SetupWindow;
  794. end;
  795.  
  796. procedure TASIconBar.WMSize(var Msg:TMessage);
  797. var
  798.   WR,CR:TRect;
  799.   aPt:TPoint;
  800. begin
  801.   GetClientRect(Parent^.HWindow,CR);
  802.   aPt.X := CR.Right;aPt.Y := CR.Top;
  803.   ClientToScreen(Parent^.HWindow,aPt);
  804.   SetWindowPos(HWindow,0,aPt.X-194,aPt.Y,194,GetSystemMetrics(sm_CYSize)+23,swp_NoZOrder);
  805.   SetFocus(Parent^.HWindow);
  806. end;
  807.  
  808. procedure TASIconBar.WMMove(var Msg:TMessage);
  809. begin
  810.     InvalidateRect(HWindow,nil,True);
  811.   DefWndProc(Msg);
  812. end;
  813.  
  814. procedure TASIconBar.WMNCLButtonDown(var Msg:TMessage);
  815. begin
  816.     DefWndProc(Msg);
  817.   SetFocus(Parent^.HWindow);
  818. end;
  819.  
  820. procedure TASIconBar.WMDrawItem(var Msg:TMessage);
  821. var
  822.     PDIS : ^TDrawItemStruct;
  823. begin
  824.     PDIS := Pointer(Msg.lParam);
  825.     case PDIS^.CtlType of
  826.         odt_Button:
  827.         case PDIS^.CtlID of
  828.             id_Bn1 :Bn1^.DrawItem(Msg);
  829.             id_Bn2 :Bn2^.DrawItem(Msg);
  830.             id_Bn3 :Bn3^.DrawItem(Msg);
  831.              id_Bn4 :Bn4^.DrawItem(Msg);
  832.              id_Bn5 :Bn5^.DrawItem(Msg);
  833.              id_Bn6 :Bn6^.DrawItem(Msg);
  834.         end;
  835.     end;
  836. end;
  837.  
  838. procedure TASIconBar.DefChildProc(var Msg: TMessage);
  839. begin
  840.   TGWindow.DefChildProc(Msg);
  841. end;
  842.  
  843. procedure TASIconBar.WMCommand(var Msg:TMessage);
  844. begin
  845.     case Msg.WParam of
  846.       id_Bn1:IDBN1(Msg);
  847.     id_Bn2:IDBN2(Msg);
  848.     id_Bn3:IDBN3(Msg);
  849.     id_Bn4:IDBn4(Msg);
  850.     id_Bn5:IDBn5(Msg);
  851.     id_Bn6:IDBN6(Msg);
  852.     cm_BPPSolid..cm_BCPYellow:SendMessage(Parent^.HWindow,
  853.             wm_Command,Msg.WParam-400,0);
  854.   end;
  855. end;
  856.  
  857.  
  858. procedure TASIconBar.IDBN1(var Msg:TMessage);
  859. begin
  860.    SetFocus(Parent^.HWindow);  
  861.   if MainWin^.Slides^.Count > 0 then
  862.         SendMessage(Parent^.HWindow,wm_command,cm_Start,0)
  863.   else
  864.       SendMessage(Parent^.HWindow,wm_Command,cm_FileOpen,0);
  865. end;
  866.  
  867. procedure TASIconBar.IDBN2(var Msg:TMessage);
  868. begin
  869.   SetFocus(Parent^.HWindow);
  870.     SendMessage(Parent^.HWindow,wm_command,cm_Stop,0);
  871. end; 
  872.  
  873. procedure TASIconBar.IDBN3(var Msg:TMessage);
  874. begin
  875.   SetFocus(Parent^.HWindow);
  876.     SendMessage(Parent^.HWindow,wm_RButtonDown,0,0);
  877. end;
  878.  
  879. procedure TASIconBar.IDBN4(var Msg:TMessage);
  880. begin
  881.   SetFocus(Parent^.HWindow);
  882.     SendMessage(Parent^.HWindow,wm_command,cm_FullScreen,0);
  883. end;
  884.  
  885. procedure TASIconBar.IDBN5(var Msg:TMessage);
  886. var
  887.     aPoint:TPoint;
  888.   aRect:TRect;
  889. begin
  890.   SetFocus(Parent^.HWindow);
  891.     aPoint.X := 0;
  892.   aPoint.Y := 25;
  893.   ClientToScreen(HWindow,aPoint);
  894.   TrackPopupMenu(HPopUpMenu,0,aPoint.x,aPoint.Y,0,HWindow,nil);
  895. end;
  896.  
  897. procedure TASIconBar.IDBN6(var Msg:TMessage);
  898. begin
  899.     SendMessage(Parent^.HWindow,wm_Command,cm_FileWin,0);
  900. end;
  901.  
  902.  
  903. {*****************************************************************}
  904. constructor TASFileWin.Init(AParent:PWindowsObject;Atitle,AFileName:Pchar);
  905. begin
  906.     TFileWindow.Init(AParent,ATitle,AFileName);
  907.   Attr.X := 100;Attr.Y := 100;
  908.   Attr.W := 500;Attr.H := 300;
  909.   Attr.Style :=  Attr.Style or ws_TiledWindow;
  910.   Attr.Menu := loadMenu(HInstance,'AS_FileCmds');
  911. end;
  912.  
  913. procedure TASFileWin.CMFileBye(var Msg:TMessage);
  914. begin
  915.     SendMessage(HWindow,wm_Close,0,0);
  916. end;
  917.  
  918. destructor TASFileWin.Done;
  919. var
  920.     Msg:TMessage;
  921. begin
  922.     SetFocus(Parent^.HWindow);
  923.   TFileWindow.Done;
  924.   MainWin^.FileWin := nil;
  925.     MainWin^.Slides^.FreeAll;
  926. end;
  927.  
  928. {*****************************************************************}
  929. procedure TASAboutDlg.WMCTLCOLOR(var Msg: TMessage);
  930.    {virtual wm_first+wm_ctlcolor; }
  931. var
  932.     H102,H103,H106,H107:HWnd;
  933.   MemDC:hDC;
  934.   OldBitmap:HBitmap;
  935.   CR:TRect;
  936.   X,Y,W,H:Integer;
  937.   LogoMetrics:TBitmap;
  938. begin
  939.   case Msg.LParamHi of
  940.     ctlColor_Static:
  941.       begin
  942.           H106 := GetItemHandle(as_AboutSt3);
  943.           H107 := GetItemHandle(108);
  944.         If H106 = Msg.lParamLo then
  945.             SetTextColor(Msg.WParam, RGB(0,0,255))
  946.         else  if h107 = Msg.lParamLO then
  947.             begin
  948.           MemDC := CreateCompatibleDC(Msg.WParam);
  949.           OldBitmap := SelectObject(MemDC,Logo);
  950.           GetClientRect(Msg.lParamLo,CR);
  951.           W:= CR.Right-CR.Left;H:= CR.Bottom-CR.Top;
  952.           GetObject(Logo,SizeOf(LogoMetrics),@LogoMetrics);
  953.           X := Max((W - LogoMetrics.bmWidth) div 2 , 0);
  954.           Y := Max((H - LogoMetrics.bmHeight) div 2 , 0);
  955.           BitBlt(Msg.WParam,X,Y,W,H,MemDc,0,0,SrcCopy);
  956.           SelectObject(MemDC,OldBitmap);
  957.           DeleteDC(MemDc);
  958.           end;
  959.  
  960.         SetBkMode(Msg.WParam, transparent);
  961.         Msg.Result := GetStockObject(Null_Brush);
  962.       end;
  963.     ctlcolor_Dlg:
  964.       begin
  965.         SetBkMode(Msg.WParam, Transparent);
  966.         If CurBrush = MainWin^.CSBr1 then
  967.             CurBrush := MainWin^.CSBr2
  968.         else
  969.             CurBrush := MainWin^.CSBr1;
  970.         Msg.Result := CurBrush;
  971.       end;
  972.   else
  973.     DefWndProc(Msg);
  974.   end;
  975. end;
  976.  
  977. procedure TASAboutDlg.SetupWindow;
  978. var
  979.     SysMenu:HMenu;
  980. begin
  981.     TDialog.SetupWindow;
  982.   SetTimer(HWindow,2,3500,nil);
  983.   Is_Timer := True;
  984.   Logo :=LoadBitmap(HInstance,'AS_Logo2');
  985. end;
  986.  
  987. {WMTimer}
  988. procedure TASAboutDlg.WMTimer(var Msg:TMessage);
  989. begin
  990.     InvalidateRect(HWindow,nil,True);
  991. end;
  992.  
  993. function TASAboutDlg.CanClose:Boolean;
  994. begin
  995.     KillTimer(HWindow,2);
  996.     Is_Timer := False;
  997.   DeleteObject(Logo);
  998.   CanClose := True;
  999. end;
  1000.  
  1001. {*****************************************************************}
  1002.  
  1003. {*****************************************************************}
  1004. {M A I N    L I N E }
  1005. {*****************************************************************}
  1006. var
  1007.   ASApp: TASApp;
  1008. begin
  1009.   ASApp.Init(AS_Name);
  1010.   ASApp.Run;
  1011.   ASApp.Done;
  1012. end.
  1013.